

basicCompactResultsPlot <- function(xlab)
{
  if(missing(xlab)) xlab <- "Increase in Probability of Conviction"
  par(mar=c(2.5, 1, 1, 1), family="serif", mfrow=c(1,1), mgp=c(0,.5,.5))
  Tvalue <- .10
  plot(x="", y="", xlab="", ylab="",
       xlim=c(-.1, .4), ylim=c(0, .1), axes=F)
  axis(side=1, at=c(-.5,-.1,0,.1,.2,.3,.4,.5,.6), 
       labels=c("","-.1",".0", ".1", ".2", ".3",".4",".5",""), 
       line=.1, cex.axis=.7, gap.axis=0)
  rect(ybottom=-1, ytop=1, xleft=-1, xright=0, col = "white", border = F)
  rect(ybottom=-1, ytop=1, xleft=0, xright=Tvalue, col = "gray90", border = F)
  rect(ybottom=-1, ytop=1, xleft=Tvalue, xright=1, col = "gray80", border = F)
  mtext(text=c("No Harm", "Tolerable Harm", "Intolerable Harm"), at=c(-.08, .05, .25),
        side=3, cex=.75, line=.20)
  mtext(text=xlab, side=1, cex=.8, line=1.5, las=1, adj=.5)
}



binomialDistPlot <- function(pg, jury_n)
{
  expected_g_distrib <- dbinom(x = 0:jury_n, size = jury_n, prob = pg)
  barplot(height=expected_g_distrib, names.arg = 0:jury_n, xlab="",
          ylab="", ylim=c(0, .30), axes=F, main="", cex.axis = .75, cex.names = .7)
  mtext(side=3, text = paste("P(k | P(g) = ", pg ,")", sep=""), line=.5, cex=.9, font=2)
  mtext(side=2, text = "Probability", line=2, cex=.9)
  mtext(side=1, text = "Initial Votes for Guilty Verdict", line=1.5, cex=.9)
  axis(side=2, at=seq(0, .30, by=.10), labels = c("0.0", "0.1", "0.2", "0.3"), las=2, cex.axis = .85, line = 0)
  box()
}


display_probabilities <- function(x, digits = 3) {
  if (is.data.frame(x)) {
    x[] <- lapply(x, format_numeric_column, digits = digits)
    return(x)
  }
  
  if (is.matrix(x)) {
    return(apply(x, c(1, 2), format_numeric_column, digits = digits))
  }
  
  format_numeric_column(x, digits = digits)
}


fit_stats_glm <- function(model)
{
  LRchi2 <- model$null.deviance - model$deviance 
  predicted.outcome <- as.numeric(model$fitted.values >= .5)
  observed.outcome  <- model$y
  cor_class <- mean(predicted.outcome == observed.outcome)
  fit_stats <- c(LRchi2 = LRchi2, 
                 pseudoR2 = LRchi2 / model$null.deviance, 
                 cor_class = cor_class, 
                 pre = (mean(observed.outcome) - (1 - cor_class)) / mean(observed.outcome))
  return(fit_stats)
}

format_numeric_column <- function(v, digits = 3) {
  if (!is.numeric(v)) {
    v[is.na(v)] <- ""
    return(v)
  }
  
  # Identify integer-valued columns
  is_integer_col <- all(is.na(v) | abs(v - round(v)) < 1e-12)
  
  out <- character(length(v))
  out[is.na(v)] <- ""   # <-- blank cells for NA
  
  if (is_integer_col) {
    out[!is.na(v)] <- as.character(as.integer(round(v[!is.na(v)])))
    return(out)
  }
  
  # Fixed decimals with trailing zeros
  s <- sprintf(paste0("%.", digits, "f"), v[!is.na(v)])
  
  # Trim leading zero only
  s <- sub("^(-?)0\\.", "\\1.", s)
  
  out[!is.na(v)] <- s
  out
}


identifyQualifiedJurors <- function(surveydata)
{
  # qualifying the jurors
  # Light: traditional juror qualifications used in most/all courts
  # Strict: Additional qualifications used in some courts (federal)
  surveydata$jq_lightDQ <- (  as.numeric(surveydata$jq_citizen=="FALSE")
                              + as.numeric(surveydata$jq_englang=="FALSE")
                              + as.numeric(surveydata$jq_notfelon=="FALSE")
                              + as.numeric(surveydata$jq_pendfelon=="FALSE")
                              + as.numeric(surveydata$jq_able=="FALSE")
                              + as.numeric(surveydata$jq_army=="FALSE")
                              + as.numeric(surveydata$jq_fireman=="FALSE") )
  
  surveydata$jq_strictDQ <- ( as.numeric(surveydata$jq_citizen=="FALSE" | surveydata$jq_citizen=="Not sure")
                              + as.numeric(surveydata$jq_englang=="FALSE" | surveydata$jq_englang=="Not sure")
                              + as.numeric(surveydata$jq_notfelon=="FALSE" | surveydata$jq_notfelon=="Not sure")
                              + as.numeric(surveydata$jq_pendfelon=="FALSE" | surveydata$jq_pendfelon=="Not sure")
                              + as.numeric(surveydata$jq_yearlive=="FALSE" | surveydata$jq_yearlive=="Not sure")
                              + as.numeric(surveydata$jq_able=="FALSE" | surveydata$jq_able=="Not sure")
                              + as.numeric(surveydata$jq_army=="FALSE" | surveydata$jq_army=="Not sure")
                              + as.numeric(surveydata$jq_fireman=="FALSE" | surveydata$jq_fireman=="Not sure")
                              + as.numeric(surveydata$jexp_2yrs=="Yes" | surveydata$jexp_2yrs=="Not sure") )
  
  # Death qualified jurors, exclude the "always" and "never" types
  # freq(surveydata$death_DQ)
  # crosstab(surveydata$death_DQ, surveydata$jq_lightDQ > 0)
  surveydata$death_DQ <- as.numeric(surveydata$vd_deathpen=="Never") + as.numeric(surveydata$vd_deathpen=="Always")
  isQualified <- (surveydata$jq_lightDQ==0 & surveydata$death_DQ==0)
  return(isQualified)
}
  

prettyPNG <- function(figure_info)
{
  png(file=figure_info$name, width=figure_info$width, height=figure_info$height, 
      units="in", type="cairo", pointsize=10, res=300, antialias="default")
}


print_table_neatly <- function(x, digits = 3) {
  if (!is.data.frame(x)) x <- as.data.frame(x)
  
  x_fmt <- display_probabilities(x, digits = digits)
  
  print(x_fmt, quote = FALSE, right = TRUE, row.names = FALSE)
  invisible(x_fmt)
}


trace_arrows <- function(sample_pg, col="black", lty=1)
{
  # sample_pg is the x-axis starting point
  # function automatically calculates the y=axis endpont
  arrow.length = .05
  horiz_stop = .1
  vert_start = .035
  segments(x0 = sample_pg, x1 = sample_pg,  
           y0 = vert_start, y1 = as.jury.point(sample_pg),  
           col=col, lty=lty)
  
  arrows(y0 = as.jury.point(sample_pg), y1 = as.jury.point(sample_pg), 
         x0 = sample_pg, x1 = horiz_stop,   
         length = arrow.length, col=col, lty=lty)
}

transition.matrix <- function(n_jurors)
{
  n_g <- 1:(n_jurors-1)
  margin_vote_prob_g <- .5*((n_g-1) / n_jurors) + .25
  prob_add_g <- margin_vote_prob_g^2
  prob_lose_g <-(1-margin_vote_prob_g)^2
  prob_same_g <- 1 - prob_add_g - prob_lose_g
  # start with all zeroes
  transition_matrix <- matrix(nrow = n_jurors+1, ncol = n_jurors+1, byrow = T, 
                              data = rep(0, (n_jurors+1)^2)) 
  # absorbing states
  transition_matrix[1,1] <- 1
  transition_matrix[n_jurors+1, n_jurors+1] <- 1
  for(i in 1:(n_jurors-1))
  {
    # stay same probabilities
    transition_matrix[i+1, i+1] <- prob_same_g[i]
    # lose one probabilities
    transition_matrix[i, i+1] <- prob_lose_g[i]
    # gain one probabilities
    transition_matrix[i+2, i+1] <- prob_add_g[i]
  }
  return(transition_matrix)  
}



